{-# LANGUAGE RecordWildCards #-}

module Strategy.Conan.ConanGraph (
  ConanGraph (..),
  ConanGraphNode (..),
  ConanGraphNodeContext (..),
  ConanPackageType (..),
  buildGraph,
  analyzeFromConanGraph,
  toDependency,
) where

import Control.Effect.Diagnostics (Diagnostics, errCtx, errHelp, run)
import Data.Aeson (
  FromJSON (parseJSON),
  Key,
  Object,
  withObject,
  withText,
  (.!=),
  (.:),
  (.:?),
 )
import Data.Aeson.Extra (TextLike (TextLike))
import Data.Aeson.Types (Parser)
import Data.Binary.Builder (toLazyByteString)
import Data.Foldable (for_)
import Data.List (sort)
import Data.Map (Map, empty, keys, lookup)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe, maybeToList)
import Data.Set qualified as Set
import Data.String.Conversion (decodeUtf8)
import Data.Text (Text)
import Data.Text.Extra (breakOnAndRemove)
import DepTypes (
  DepEnvironment (..),
  DepType (ConanType),
  Dependency (..),
  VerConstraint (CEq),
 )
import Diag.Diagnostic (ToDiagnostic (renderDiagnostic))
import Effect.Exec (
  AllowErr (Never),
  Command (..),
  Exec,
  Has,
  execJson,
 )
import Effect.Grapher (Grapher, deep, direct, edge, evalGrapher)
import Errata (Errata (..))
import Graphing (Graphing)
import Network.HTTP.Types (renderQueryText)
import Path (Abs, Dir, Path)
import Strategy.Conan.Version (guardConanVersion2Gt)

-- | Represents `conan install . -f json`.
-- Creates the dependency graph from install command.
--
-- Why not `conan graph info` command? This is because, if
-- end-user HAS not installed dependencies using "tools.build:download_source=True"
-- option, than simply source directory will be empty, regardless even if we
-- pass this option in `conan graph info` command. This is not documented,
-- but was communicated in: https://github.com/conan-io/conan/issues/13939
--
-- >> conan install . -f json
-- >
-- > {
-- >  "nodes": [
-- >    {
-- >       "ref": "conanfile",
-- >       "id": 0,
-- >        ....
-- >    },
-- >  ],
-- >  "root": {..}
-- > }
conanV2GraphCmd :: [Text] -> Command
conanV2GraphCmd extraArgs =
  Command
    { cmdName = "conan"
    , cmdArgs = ["install", ".", "-f", "json", "-c", "tools.build:download_source=True"] <> extraArgs
    , cmdAllowErr = Never
    }

data ConanGraph = ConanGraph
  { nodes :: [ConanGraphNode]
  , root :: Map Text Text
  }
  deriving (Show, Eq, Ord)

instance FromJSON ConanGraph where
  parseJSON = withObject "ConanGraph" $ \obj ->
    ConanGraph
      <$> obj .: "graph" |> "nodes"
      <*> obj .: "graph" |> "root"
    where
      (|>) :: FromJSON a => Parser Object -> Key -> Parser a
      (|>) parser key = do
        obj <- parser
        obj .: key

data ConanGraphNode = ConanGraphNode
  { -- Node reference
    ref :: TextLike
  , -- Unique Node Id for this node in the graph
    nodeid :: TextLike
  , -- Signifies the package identifier, which
    -- is generated by combination of settings,
    -- options, and package name, package version.
    packageId :: Text
  , -- Title of the package
    name :: Text
  , -- Version of the package
    version :: Text
  , -- Context, refer to @ConanGraphNodeContext@
    context :: ConanGraphNodeContext
  , -- Settings associated with package in dependency graph.
    -- Settings are key, value attributes like os, compiler etc.
    -- Refs:
    -- - https://docs.conan.io/2/tutorial/consuming_packages/different_configurations.html#settings-and-options-difference
    -- - https://github.com/conan-io/conan/issues/794
    settings :: Map Text Text
  , -- These are options of the dependency, used
    -- during the build. These may be used in source
    -- retrieval!
    options :: Map Text (Maybe Text)
  , -- refer to @ConanPackageType@
    packgeType :: ConanPackageType
  , -- This is source directory where the source code is retrieved
    sourceFolder :: Maybe Text
  , -- This is the build directory where artifact is built for usage
    buildFolder :: Maybe Text
  , -- True if it is a test package, Otherwise False.
    test :: Bool
  , -- Dependencies
    requires :: Map Text Text
  }
  deriving (Show, Eq, Ord)

instance FromJSON ConanGraphNode where
  parseJSON = withObject "ConanGraphNode" $ \obj -> do
    (name, version) <- obj `parseNameVersion` "label"
    ConanGraphNode
      <$> obj .: "ref"
      <*> obj .: "id"
      <*> obj .: "package_id"
      <*> (pure name)
      <*> (pure version)
      <*> obj .: "context"
      <*> obj .: "settings" .!= empty
      <*> obj .: "options" .!= empty
      <*> obj .: "package_type"
      <*> obj .:? "source_folder"
      <*> obj .:? "build_folder"
      <*> obj .: "test"
      <*> obj .: "requires" .!= empty
    where
      parseNameVersion :: Object -> Key -> Parser (Text, Text)
      parseNameVersion obj key = do
        value <- obj .: key
        case value of
          "conanfile.py" -> pure ("conanfile.py", "")
          "conanfile.txt" -> pure ("conanfile.txt", "")
          _ -> case breakOnAndRemove "/" value of
            Nothing -> fail $ "Expected " <> show key <> " to have, / seperator, but recieved: " <> show value
            Just (name, version) -> pure (name, version)

data ConanGraphNodeContext
  = -- The host context is populated with the root package
    -- (the one specified in the conan install or conan create command),
    -- all its requirements are of "host" context.
    HostContext
  | -- The build context contains the rest of build requirements
    -- and all of them in the profiles. This category typically includes
    -- all the dev tools like CMake, compilers, linkers.
    BuildContext
  | -- Other context. Conan as of v2.0.5 only has build and host context
    -- but this other context is added as saftey hatch, if in future
    -- additional context are added. Our parser should not fail outright
    -- if the context is not recognized.
    OtherContext Text
  deriving (Show, Eq, Ord)

instance FromJSON ConanGraphNodeContext where
  parseJSON = withText "Context" $ \ctx -> do
    case ctx of
      "host" -> pure HostContext
      "build" -> pure BuildContext
      other -> pure $ OtherContext other

-- | Conan's package type
-- Doc: https://docs.conan.io/2.0/reference/conanfile/attributes.html#package-type
data ConanPackageType
  = -- The package is an application.
    Application
  | -- The package is a generic library.
    Library
  | -- The package is a shared library.
    SharedLibrary
  | -- The package is a static library.
    StaticLibrary
  | -- The package is a header only library.
    HeaderLibrary
  | -- The package only contains build scripts.
    BuildScript
  | -- The package is a python require.
    PythonRequires
  | -- The type of the package is unknown.
    Unknown Text
  deriving (Show, Eq, Ord)

instance FromJSON ConanPackageType where
  parseJSON = withText "ConanPackageType" $ \ctx -> do
    case ctx of
      "application" -> pure Application
      "library" -> pure Library
      "shared-library" -> pure SharedLibrary
      "static-library" -> pure StaticLibrary
      "header-library" -> pure HeaderLibrary
      "build-scripts" -> pure BuildScript
      "python-require" -> pure PythonRequires
      other -> pure $ Unknown other

indexById :: ConanGraph -> Map TextLike ConanGraphNode
indexById = mempty

mkGraph :: Has (Grapher Dependency) sig m => ConanGraph -> m ()
mkGraph conanGraph = do
  for_ (nodes conanGraph) $ \dep -> do
    let resolvedDep = toDependency dep
    if isDirectDep dep
      then direct resolvedDep
      else deep resolvedDep

    let transitives = mapMaybe (refToDependency . TextLike) (keys $ requires dep)
    for_ transitives $ \childDep -> do
      deep childDep
      edge resolvedDep childDep
  where
    registry :: Map TextLike ConanGraphNode
    registry = indexById conanGraph

    isDirectDep :: ConanGraphNode -> Bool
    isDirectDep _ = True

    refToDependency :: TextLike -> Maybe Dependency
    refToDependency nodeId = toDependency <$> Data.Map.lookup nodeId registry

toDependency :: ConanGraphNode -> Dependency
toDependency cn =
  Dependency
    { dependencyType = ConanType
    , dependencyName = name cn
    , dependencyVersion = Just (CEq $ getVersion cn)
    , dependencyLocations = getLocations cn
    , dependencyEnvironments = Set.singleton $ getEnv cn
    , dependencyTags = mempty
    }

getLocations :: ConanGraphNode -> [Text]
getLocations cn = case packgeType cn of
  SharedLibrary -> maybeToList $ buildFolder cn
  _ -> case sourceFolder cn of
    Just srcFolder -> [srcFolder]
    _ -> maybeToList $ buildFolder cn

getEnv :: ConanGraphNode -> DepEnvironment
getEnv ConanGraphNode{..} = case (test, context) of
  (True, _) -> EnvTesting
  (_, BuildContext) -> EnvDevelopment
  (_, HostContext) -> EnvProduction
  _ -> EnvProduction

-- | Retrieves conan package's version.
-- If the package has settings (os, compiler, etc.)
-- they are appended as URI params. Package ID as
-- determined by conan is also added as URI param.
-- -
-- Example:
--   - 2.3.4?package_id=someId&os=win&arch=arm64
--   - 2.3.4?package_id=someId
getVersion :: ConanGraphNode -> Text
getVersion cn =
  version cn
    <> mkUrlQuery
      ( [ ("package_id", Just $ packageId cn)
        ]
          <> Map.toList (Map.map Just $ settings cn)
      )

mkUrlQuery :: [(Text, Maybe Text)] -> Text
mkUrlQuery qs = decodeUtf8 $ toLazyByteString $ renderQueryText True (sort qs)

buildGraph :: ConanGraph -> Graphing Dependency
buildGraph conanGraph = run . evalGrapher $ mkGraph conanGraph

analyzeFromConanGraph :: (Has Exec sig m, Has Diagnostics sig m) => Path Abs Dir -> m (Graphing Dependency)
analyzeFromConanGraph dir = do
  -- We only support conan v2 or greater for this tactic,
  -- since, conan v1 does not have equiavlent command, which
  -- would ensure source code is always retrieved. Also, the
  -- equivalent command of "conan info ." in conan v1
  -- does not provide used settings for the dependency.
  errCtx ConanV2IsRequiredCtx $ errHelp ConanV2IsRequiredHelp $ guardConanVersion2Gt dir

  conanGraph <- execJson dir $ conanV2GraphCmd []
  pure $ buildGraph conanGraph

data ConanV2IsRequired
  = ConanV2IsRequiredCtx
  | ConanV2IsRequiredHelp
instance ToDiagnostic ConanV2IsRequired where
  renderDiagnostic ConanV2IsRequiredCtx = do
    let header = "Conan analysis requires conan v2.0.0 or greater"
    Errata (Just header) [] Nothing
  renderDiagnostic ConanV2IsRequiredHelp = do
    let header = "Ensure you are using conan v2 by running, conan --version"
    Errata (Just header) [] Nothing
